COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 The Swapper
C00004 00003	 The swap file is just a vector of bps contents.
C00011 ENDMK
C⊗;
;;; The Swapper

(declare 
 (special -swap-channel- -swap-bporg- -swap-starts-index- -current-dispatch-
	  -dispatch-address-)
 (fixnum -swap-channel- -swap-bporg- -swap-starts-index- -current-dispatch-
	 -dispatch-address-))

(array -swap-starts- fixnum 20.)

(defun initialize-swap (file)
       (setq -swap-starts-index- 0)
       (setq -swap-channel- (open-swap file)
	     -swap-bporg- bporg))

(defun initial-swap-out ()
 (let n ← (- bporg -swap-bporg-)
      do
      (swap-out-here -swap-channel-
		     (+ 1 n)
		     -swap-bporg-)
      (store (-swap-starts- -swap-starts-index-)
	     (+ 1 (// n 128.)))
      (setq -swap-starts-index- (1+ -swap-starts-index-))
      (setq bporg -swap-bporg-)))

;;; This is appears AFTER each function has been loaded

(defun initialize-function-swap (name)
 (swap-table-setup -current-dispatch-
		   (+ 1 (- bporg -swap-bporg-)))
 (putprop name -current-dispatch- 'subr)
 (setq -current-dispatch- (+ 2 -current-dispatch-)))
;;; The swap file is just a vector of bps contents.

;;; (swap-open '(swap spc dsk (foo bar)))

(lap swap-open subr)
(args swap-open (nil . 1))
(move a 0 a)
(pushj p p-file)		;parse file name and fill in values

(pushj p alchan)

(movei tt 17)			;open dsk in dump mode
(move d device)			;device = 'dsk
(setz r)

(move ar1 xopen)
(ior ar1 chn)
(xct 0 ar1)

(lerr 0 (% sixbit |CANNOT OPEN DEVICE!|))
(Move tt file)			;Lookup file
(hllz d ext)
(setz r)
(move f ppn)

(move ar1 xlookup)
(ior ar1 chn)
(xct 0 ar1)

(lerr 0 (% sixbit |CANNOT LOOKUP FILE!|))

(Move tt file)			;Enter file
(hllz d ext)
(setz r)
(move f ppn)

(move ar1 xenter)
(ior ar1 chn)
(xct 0 ar1)

(lerr 0 (% sixbit |CANNOT ENTER FILE!|))

(move tt chn)	;channel number returned
(jsp t fxcons)
(popj p)

;;; (swap-in <channel-number> <start> -<length> <bporg>)
(entry swap-in subr)
(args swap-in (nil . 3))
(move a 0 a)	;channel number in a
(move b 0 b)	;start in the file
(move c 0 c)	;-length
(move d 0 d)	;bporg
(sos d)
(move ar1 xuseti)
(ior ar1 b)
(ior ar1 a)
(xct 0 ar1)	;get there

(hrlm c iwd)
(hrrm c iwd)
(move ar1 xin1)
(ior ar1 b)
(xct 0 ar1)	;read it in!!!
(movei a 't)	;right!!!
(popj p)

;;; (swap-out <channel-number> <start> <length> <bporg>)
(entry swap-out subr)
(args swap-out (nil . 3))
(move a 0 a)	;channel number in a
(move b 0 b)	;start in the file
(movn c 0 c)	;-length
(move d 0 d)	;bporg
(sos d)
(move ar1 xuseto)
(ior ar1 b)
(ior ar1 a)
(xct 0 ar1)	;get there

(hrlm c iwd)
(hrrm c iwd)
(ior ar1 b)
(xct 0 ar1)	;write it out!!!
(movei a 't)	;right!!!
(popj p)

;;; (swap-out-here <channel-number> <length> <bporg>)
(entry swap-out subr)
(args swap-out (nil . 3))
(move a 0 a)	;channel number in a
(movn b 0 b)	;-length
(move c 0 c)	;bporg
(sos c)

(move ar1 xugetf)
(ior ar1 a)
(xct 0 ar1)	;move to the end

(hrlm b iwd)
(hrrm b iwd)
(ior ar1 c)
(xct 0 ar1)	;write it out!!!
(movei a 't)	;right!!!

;;; (close-swap <channel>)
(entry close-swap subr)
(args close-swap (nil . 1))
(move a 0 a)
(move ar1 xclose)
(ior ar1 a)
(xct 0 ar1)
(move ar1 xrelease)
(ior ar1 chn)
(xct 0 ar1)

(movei a 't)
(popj p)

p-file
(push p a)
(HLRZ a 0 a) 			;car = file name
(pushj p sixmak)
(movem tt file)
(HRRZ a @ 0 p)
(movem a  0 p)			;one cdr
(HLRZ a 0 a)			;cadr = file extension
(pushj p sixmak)
(movem tt ext)
(HRRZ a @ 0 p) 
(movem a  0 p)			;two cdr's
(HLRZ a 0 a) 			;caddr = device
(pushj p sixmak)
(movem tt device)
(hrrz a @ 0 p)			;three cdr's
(hlrz a 0 a)			;last item
(movem a  0 p)
(HLRZ a 0 a) 			;(car (cadddr )) = proj
(pushj p sixmak)
(pushj p just)
(hllm tt ppn)
(hrrz a @ 0 p)
(HLRZ a @ a)			;(cadr (cadddr )) = prog
(pushj p sixmak)
(pushj p just)			;silly SAIL ppn justifier
(hlrm tt ppn)
(sub p (% 0 0 1 1))
(popj p)

alchan
(move tt point)
loop1
(move ar1 0 tt)
(jumpe ar1 found)
(aobjn tt loop1)
(lerr 0 (% sixbit |No channels available!|))
found
(hrrzs 0 tt)
(subi tt chntb)
(movei ar1 0 tt)
(movem ar1 chnn)
(lsh tt 27)
(movem tt chn)
(addi ar1 chntb)
(movsi tt 400000)
(movem tt 0 ar1)
(popj p)

SIXMAK 	(MOVEI B '6)				;direct lift from faslap
	(CALL 2 'PNGET)
	(HLRZ A 0 A)
	(MOVE TT 0 A)
	(POPJ P)
JUST	(TLNE TT 77)
	(POPJ P)
	(LSH TT -6)
	(JRST 0 JUST)

file (0)
ext (0)
device (0)
ppn (0)

xopen 		(open 0 tt)
xlookup		(lookup 0 tt)
xrelease	(release 0 0)
xin 		(in 0 0)
xin1		(in 0 iwd)
xout1		(out 0 iwd)
xenter		(enter 0 tt)
xout		(out 0 iowd)
xinbuf		(inbuf 0 1)
xoutbuf		(outbuf 0 1)
xugetf		(ugetf 0 tt)
xugtfb		(ugetf 0 f)
xuseti		(useti 0 tt)
xuseto		(useto 0 tt)
xustoa		(useto 0 0 r)
xustia		(useti 0 0 r)
xclose		(close 0 0)
xustob		(useto 0 0 f)
iwd		(0)
xout0		(out 0 0)
chn 		(0)
chnn 		(0)
point 		(77776←25 0 chntb)	;-20,,chntb

(entry swap-dispatch subr)
(args swap-dispatch (nil . 0))

(setz tt)
(jrst 0 swapin)
(movei tt 1)
(jrst 0 swapin)

swapin
(skipl 0 funtab tt)
(jrst 0 @ funtab tt)

;;; Funtab is of the form:
;;; in,,addr
;;; where in is positive, meaning the function is in core
;;; or it is neg and means that it is not in core
;;; and addr the real core address or the record number
;;; |lh| is the length in words
;;;
funtab
(block 200)